Installation

Install R
Install RTools if you are on Windows
Install RStudio

For more details, see Software and Package Versions.

Running This Code

Ensure the installation steps above are completed
Download a zip of the code and data here and unzip it
- Code Repository: github.com/rrwen/recovr-eval
In RStudio, open the src/src.Rproj file
Then, open the src/index.Rmd file
In RStudio:
- Run all code: Click the Run drop down (top right of the code pane) and click Run All
- Generate HTML version: Click knit (top left of code pane) and a file will be generated in docs/index.html

Libraries

Install R packages if needed.

# Required packages
required_packages <- c(
    "rmarkdown",
    "bookdown",
    "knitr",
    "tidyverse",
    "purrr",
    "glue",
    "lubridate",
    "scales",
    "patchwork",
    "DiagrammeR",
    "DiagrammeRsvg",
    "webshot2",
    "magick",
    "rsvg",
    "sf",
    "tmap",
    "ggspatial",
    "prettymapr",
    "units"
)

# Try to install packages if not installed
default_options <- options()
tryCatch(
    {
        # Disable interactivity
        options(install.packages.compile.from.source = "always")
        
        # Install package if not installed
        for (package in required_packages) {
            is_package_installed <- require(package, character.only = TRUE)
            if (!is_package_installed) {
                cat(paste0("Installing package: ", package, "\n"))
                install.packages(package)
            } else {
                cat(paste0("Package already installed: ", package, "\n"))
            }
        }
    },
    error = function(cond) {
        stop(cond)
    },
    finally = {
        options(default_options) # reset interactivity
    }
)

Load R libraries.

library(DiagrammeR)
library(ggplot2)
library(ggspatial)
library(glue)
library(lubridate)
library(patchwork)
library(sf)
library(tidyverse)
library(tmap)

Data

Read data from the data folder.

ddesc <- read_csv("../data/data.csv")
ddesc

Vancouver Bikeways

Bikeways data with manually verified (Google Street View/Earth and Web Search) painted lanes and cycle tracks for Vancouver, Canada

Download Link: https://github.com/rrwen/recovr-infracycle/blob/main/data/vancouver-bikeways-preprocess-v1.geojson
Download Date: June 02, 2024
Data Updated: April 06, 2024
Notes: Originally downloaded on January 2023 from bikeways data at https://opendata.vancouver.ca/explore/dataset/bikeways

# Read data
vancbike_raw <- read_sf("../data/vancouver-bikeways-2024-06-02.geojson")

# Get download date
vancbike_dldate <- ddesc %>% filter(
    file == "vancouver-bikeways-2024-06-02.geojson"
) %>% pull(download_date)

Map

Only the first 1000 records are shown.

tmap_mode("view")
tm_shape(vancbike_raw %>% head(1000)) +
    tm_lines(
        col = "#336699",
        border.col = "white",
        popup.vars = TRUE
    )

Data

Columns: 23
Rows: 3666

vancbike_raw %>% as_tibble

Dictionary

The data contains the following columns:

vancbike_ddict <- read_csv("../data/vancouver-bikeways-2024-06-02-datadict.csv")
vancbike_ddict

Details

print(vancbike_raw)

## Simple feature collection with 3666 features and 22 fields
## Geometry type: LINESTRING
## Dimension:     XY
## Bounding box:  xmin: -123.2238 ymin: 49.19899 xmax: -123.0233 ymax: 49.31428
## Geodetic CRS:  WGS 84
## # A tibble: 3,666 × 23
##    id     street     status road_type road_type_recode install_year install_type
##    <chr>  <chr>      <chr>  <chr>     <chr>                   <dbl> <chr>       
##  1 294725 Highbury   Active Resident… Local                    2006 Local Street
##  2 294726 Highbury   Active Resident… Local                    2006 Local Street
##  3 294731 W 8th Ave  Active Resident… Local                    1994 Local Street
##  4 294732 W 8th Ave  Active Resident… Local                    1994 Local Street
##  5 294733 Off Street Active Lane      Local                    2003 Protected B…
##  6 294736 W 5th Ave  Active Resident… Local                    2009 Local Street
##  7 294737 W 8th Ave  Active Resident… Local                    1994 Local Street
##  8 294738 W 7th Ave  Active Resident… Local                    1994 Local Street
##  9 294739 W 7th Ave  Active Resident… Local                    1994 Local Street
## 10 294742 W 7th Ave  Active Resident… Local                    1994 Local Street
## # ℹ 3,656 more rows
## # ℹ 16 more variables: verify_install_year <dbl>, verify_install_date <chr>,
## #   verify_install_type <chr>, verify_install_comment <chr>,
## #   verify_upgrade1_year <dbl>, verify_upgrade1_date <chr>,
## #   verify_upgrade1_type <chr>, verify_upgrade1_comment <chr>,
## #   verify_upgrade2_year <dbl>, verify_upgrade2_date <chr>,
## #   verify_upgrade2_type <chr>, verify_upgrade2_comment <chr>, …

Files

The data files are available below:

Calgary Bikeways

Bikeways data with manually verified (Google Street View/Earth and Web Search) painted lanes and cycle tracks for Calgary, Canada

Download Link: https://github.com/rrwen/recovr-eval/blob/main/data/calgary-bikeways-2024-06-05.geojson
Download Date: June 05, 2024
Data Updated: June 05, 2024
Notes: Originally downloaded on January 2023 from bikeways data at https://data.calgary.ca/Transportation-Transit/Calgary-Bikeways/yigb-2xmq, updated from https://github.com/rrwen/recovr-infracycle/blob/main/data/calgary-bikeways-preprocess-v1.geojson to include years for install/upgrade dates with no years (see https://github.com/rrwen/recovr-eval/blob/main/src/archive/calgary-bikeways-2024-06-05.R)

# Read data
calgbike_raw <- read_sf("../data/calgary-bikeways-2024-06-05.geojson")

# Get download date
calgbike_dldate <- ddesc %>% filter(
    file == "calgary-bikeways-2024-06-05.geojson"
) %>% pull(download_date)

Map

Only the first 1000 records are shown.

tmap_mode("view")
tm_shape(calgbike_raw %>% head(1000)) +
    tm_lines(
        col = "#336699",
        border.col = "white",
        popup.vars = TRUE
    )

Data

Columns: 22
Rows: 4169

calgbike_raw %>% as_tibble

Dictionary

The data contains the following columns:

calgbike_ddict <- read_csv("../data/calgary-bikeways-2024-06-05-datadict.csv")
calgbike_ddict

Details

print(calgbike_raw)

## Simple feature collection with 4169 features and 21 fields
## Geometry type: MULTILINESTRING
## Dimension:     XY
## Bounding box:  xmin: -114.269 ymin: 50.89762 xmax: -113.9302 ymax: 51.17778
## Geodetic CRS:  WGS 84
## # A tibble: 4,169 × 22
##    id    street status   road_type road_type_recode install_year install_type   
##    <chr> <chr>  <chr>    <chr>     <chr>                   <dbl> <chr>          
##  1 1     <NA>   EXISTING <NA>      <NA>                     2003 On-Street Bike…
##  2 2     <NA>   EXISTING <NA>      <NA>                     2009 On-Street Bike…
##  3 3     <NA>   EXISTING <NA>      <NA>                     2009 On-Street Bike…
##  4 4     <NA>   EXISTING <NA>      <NA>                     1999 On-Street Bike…
##  5 5     <NA>   EXISTING <NA>      <NA>                     1999 On-Street Bike…
##  6 6     <NA>   EXISTING <NA>      <NA>                     2005 On-Street Bike…
##  7 7     <NA>   EXISTING <NA>      <NA>                     1999 On-Street Bike…
##  8 8     <NA>   EXISTING <NA>      <NA>                     1999 On-Street Bike…
##  9 9     <NA>   EXISTING <NA>      <NA>                     1999 On-Street Bike…
## 10 10    <NA>   INACTIVE <NA>      <NA>                       NA DECOMMISSIONED 
## # ℹ 4,159 more rows
## # ℹ 15 more variables: verify_install_year <dbl>, verify_install_date <chr>,
## #   verify_install_type <chr>, verify_install_comment <chr>,
## #   verify_upgrade1_year <dbl>, verify_upgrade1_date <chr>,
## #   verify_upgrade1_type <chr>, verify_upgrade1_comment <chr>,
## #   verify_upgrade2_year <dbl>, verify_upgrade2_date <chr>,
## #   verify_upgrade2_type <chr>, verify_upgrade2_comment <chr>, …

Files

The data files are available below:

Toronto Bikeways

Bikeways data with manually verified (Google Street View/Earth and Web Search) painted lanes and cycle tracks for Toronto, Canada

Download Link: https://github.com/rrwen/recovr-infracycle/blob/main/data/toronto-bikeways-preprocess-v1.geojson
Download Date: June 02, 2024
Data Updated: April 08, 2024
Notes: Originally downloaded on January 2023 from bikeways data at https://open.toronto.ca/dataset/bikeways/

# Read data
toronbike_raw <- read_sf("../data/toronto-bikeways-2024-06-02.geojson")

# Get download date
toronbike_dldate <- ddesc %>% filter(
    file == "toronto-bikeways-2024-06-02.geojson"
) %>% pull(download_date)

Map

Only the first 1000 records are shown.

tmap_mode("view")
tm_shape(toronbike_raw %>% head(1000)) +
    tm_lines(
        col = "#336699",
        border.col = "white",
        popup.vars = TRUE
    )

Data

Columns: 23
Rows: 1323

toronbike_raw %>% as_tibble

Dictionary

The data contains the following columns:

toronbike_ddict <- read_csv("../data/toronto-bikeways-2024-06-02-datadict.csv")
toronbike_ddict

Details

print(toronbike_raw)

## Simple feature collection with 1323 features and 22 fields
## Geometry type: MULTILINESTRING
## Dimension:     XY
## Bounding box:  xmin: -79.63039 ymin: 43.58221 xmax: -79.11803 ymax: 43.85546
## Geodetic CRS:  WGS 84
## # A tibble: 1,323 × 23
##    id    street    street_from street_to road_type road_type_recode install_year
##    <chr> <chr>     <chr>       <chr>     <chr>     <chr>                   <dbl>
##  1 8     Bloor St… Parliament… Castle F… Major Ar… Arterial                 2001
##  2 17    Lake Sho… Humber Bay… Humber B… Major Ar… Arterial                 2001
##  3 18    Lake Sho… 37 M E Fle… Humber B… Major Ar… Arterial                 2001
##  4 19    Lake Sho… 50.7 M E L… 37 M E F… Major Ar… Arterial                 2001
##  5 38    Queens Q… Martin Goo… Bathurst… Collector Collector                2001
##  6 39    Davenpor… Cottingham… Macphers… Minor Ar… Arterial                 2001
##  7 40    Elizabet… College St  Gerrard … Collector Collector                2001
##  8 41    Gerrard … Yonge St    Church St Minor Ar… Arterial                 2001
##  9 42    Macphers… Davenport … Poplar P… Collector Collector                2001
## 10 43    Lake Sho… Marine Par… Palace P… Major Ar… Arterial                 2001
## # ℹ 1,313 more rows
## # ℹ 16 more variables: install_type <chr>, verify_install_year <dbl>,
## #   verify_install_date <chr>, verify_install_type <chr>,
## #   verify_install_comment <chr>, verify_upgrade1_year <dbl>,
## #   verify_upgrade1_date <chr>, verify_upgrade1_type <chr>,
## #   verify_upgrade1_comment <chr>, verify_upgrade2_year <dbl>,
## #   verify_upgrade2_date <chr>, verify_upgrade2_type <chr>, …

Files

The data files are available below:

Verified Dates

The verification dates manually entered for the cycling infrastructure data were unstructured and do not follow a structured format suitable for analysis.

Nevan Opp nevanopp@cmail.carleton.ca went through the dates in Google Sheets, interpreted them, and formatted them into structured dates, while Richard Wen richard.wen@utoronto.ca updated and fixed errors as needed.

These structured dates can then be joined back to the unstructured dates to include higher resolution temporal data to the cycling infrastructure install and upgrade dates.

Download Link: https://github.com/rrwen/recovr-eval/blob/main/data/verify-dates-2024-06-12.csv
Download Date: June 12, 2024
Data Updated: June 12, 2024
Notes: See sheet “Instructions” at https://docs.google.com/spreadsheets/d/14c9qyCr8Wmy9yJzcB6x_RNP6fU3ZAiJh7e-IE47d6D8

# Read data
vdates_raw <- read_csv("../data/verify-dates-2024-06-12.csv")

# Get download date
vdates_dldate <- ddesc %>% filter(
    file == "verify-dates-2024-06-12.csv"
) %>% pull(download_date)

Data

Columns: 8
Rows: 298

vdates_raw

Dictionary

The data contains the following columns:

vdates_ddict <- read_csv("../data/verify-dates-2024-06-12-datadict.csv")
vdates_ddict

Files

The data files are available below:

Toronto KSI

KSI (2006-2022) data from the Toronto Police Service (TPS) Public Safety Data Portal for Toronto, Ontario

Download Link: https://data.torontopolice.on.ca/datasets/0a1ee9d9436546dcbdc0ee9301e45e83_0
Download Date: June 01, 2024
Data Updated: May 03, 2024
Notes: Documentation available at docs/tps-data-doc-2024-01-10.pdf (pages 12-14), Open Government Licence – Ontario

# Read data
ksi_raw <- read_sf("../data/toronto-ksi-2024-06-01.geojson")

# Get download date
ksi_dldate <- ddesc %>% filter(
    file == "toronto-ksi-2024-06-01.geojson"
) %>% pull(download_date)

Map

Note: Due to the large number of records, only the latest year of 2023 is displayed (n = 695).

tmap_mode("view")
tm_shape(ksi_raw %>% filter(year(DATE) == max(year(DATE)))) +
    tm_dots(
        col = "ACCLASS",
        clustering = TRUE,
        popup.vars = TRUE
    )

Data

Columns: 53
Rows: 18957

ksi_raw %>% as_tibble()

Dictionary

The data contains the following columns:

ksi_ddict <- read_csv("../data/toronto-ksi-2024-06-01-datadict.csv")
ksi_ddict

Details

print(ksi_raw)

## Simple feature collection with 18957 features and 52 fields
## Geometry type: POINT
## Dimension:     XY
## Bounding box:  xmin: -79.63839 ymin: 43.58968 xmax: -79.12297 ymax: 43.85545
## Geodetic CRS:  WGS 84
## # A tibble: 18,957 × 53
##    OBJECTID INDEX_  ACCNUM DATE                TIME  STREET1      STREET2 OFFSET
##       <int> <chr>   <chr>  <dttm>              <chr> <chr>        <chr>   <chr> 
##  1        1 3389067 893184 2006-01-01 05:00:00 236   WOODBINE AVE O CONN… <NA>  
##  2        2 3389068 893184 2006-01-01 05:00:00 236   WOODBINE AVE O CONN… <NA>  
##  3        3 3389069 893184 2006-01-01 05:00:00 236   WOODBINE AVE O CONN… <NA>  
##  4        4 3389070 893184 2006-01-01 05:00:00 236   WOODBINE AVE O CONN… <NA>  
##  5        5 3389071 893184 2006-01-01 05:00:00 236   WOODBINE AVE O CONN… <NA>  
##  6        6 3389072 893184 2006-01-01 05:00:00 236   WOODBINE AVE O CONN… <NA>  
##  7        7 3389073 893184 2006-01-01 05:00:00 236   WOODBINE AVE O CONN… <NA>  
##  8        8 3389074 893184 2006-01-01 05:00:00 236   WOODBINE AVE O CONN… <NA>  
##  9        9 3433023 909646 2006-01-01 05:00:00 315   DANFORTH AVE WEST L… <NA>  
## 10       10 3433024 909646 2006-01-01 05:00:00 315   DANFORTH AVE WEST L… <NA>  
## # ℹ 18,947 more rows
## # ℹ 45 more variables: ROAD_CLASS <chr>, DISTRICT <chr>, LATITUDE <dbl>,
## #   LONGITUDE <dbl>, ACCLOC <chr>, TRAFFCTL <chr>, VISIBILITY <chr>,
## #   LIGHT <chr>, RDSFCOND <chr>, ACCLASS <chr>, IMPACTYPE <chr>, INVTYPE <chr>,
## #   INVAGE <chr>, INJURY <chr>, FATAL_NO <int>, INITDIR <chr>, VEHTYPE <chr>,
## #   MANOEUVER <chr>, DRIVACT <chr>, DRIVCOND <chr>, PEDTYPE <chr>,
## #   PEDACT <chr>, PEDCOND <chr>, CYCLISTYPE <chr>, CYCACT <chr>, …

Files

The data files are available below:

Cleaning

Combine Bikeways

Combine bikeway data across all cities.

# List of city bikeway data
bike_list <- list(
    vancouver = vancbike_raw,
    calgary = calgbike_raw %>%
        mutate(no_verify_install_type = NA),
    toronto = toronbike_raw %>%
        mutate(no_verify_install_type = NA)
)

# Get common columns across all city bikeways
bike_cols <- bike_list %>%
    map(colnames) %>%
    reduce(intersect)

# Combine bikeway data across cities
bike_raw <- names(bike_list) %>%
    map(function(city) {
        bike_list[[city]] %>%
            select(
                all_of(bike_cols)
            ) %>%
            mutate(
                city = factor(city, levels = names(bike_list)),
                .before = 1
            )
    }) %>%
    reduce(add_row)

# Display combined bikeway data
bike_raw %>% as_tibble

Pivot Long Format

Pivot to long format, where each record represents an installationa or upgrade.

Also adds the following columns:

_pivot_type: one of install, upgrade1, or upgrade2
_pivot_year: the year of the install or upgrade from verify_install_year, verify_upgrade1_year, or verify_upgrade2_year

# Pivot to long format on installs and upgrades
bike <- bike_raw %>%
    pivot_longer(
        cols = c(
            verify_install_date,
            verify_upgrade1_date,
            verify_upgrade2_date
        ),
        names_to = "_pivot_column",
        values_to = "_pivot_value"
    ) %>%
    mutate(
        `_pivot_type` = case_when(
            str_starts(`_pivot_column`, "verify_install") ~ "install",
            str_starts(`_pivot_column`, "verify_upgrade1") ~ "upgrade1",
            str_starts(`_pivot_column`, "verify_upgrade2") ~ "upgrade2"
        ),
        `_pivot_year` = case_when(
            `_pivot_type` == "install" ~ verify_install_year,
            `_pivot_type` == "upgrade1" ~ verify_upgrade1_year,
            `_pivot_type` == "upgrade2" ~ verify_upgrade2_year
        )
    )

# Display pivot columns
bike %>%
    as_tibble %>%
    select(
        `_pivot_type`,
        `_pivot_year`,
        `_pivot_column`,
        `_pivot_value`,
        everything()
    ) %>%
    arrange(`_pivot_year`)

Add Clean Dates

Join ambiguous verified install/upgrade dates (e.g. Jan 1/2022, 2022/02, Fall 2020) to manually cleaned dates with structured time units (e.g. days, months, quarters, semesters, ranges) and date formats (e.g. 2022-01-01, 2022-02-01).

The following cleaned structured date columns will be added:

verify_date_raw_count
verify_date_type
verify_date
verify_date_start
verify_date_end
verify_date_prepost
verify_date_notes

# Join clean dates to include structured date formats
bike <- bike %>%
    left_join(
        vdates_raw,
        by = join_by(`_pivot_value` == verify_date_raw)
    )

# Display clean dates cols
bike %>%
    as_tibble %>%
    select(all_of(
        colnames(vdates_raw) %>%
            .[. != "verify_date_raw"]
    )) %>%
    arrange(verify_date_type)

Add Time Units

Add the following time unit columns for installs/upgrades:

_time_month: which month (1, 2, 3 … 12) a bikeway had a verified installation/upgrade
_time_quarter: which quarter (1, 2, 3, 4) of the year a bikeway had a verified installation/upgrade
_time_third: which third (1, 2, 3) of the year a bikeway had a verified installation/upgrade
_time_half: which half (1, 2) of the year a bikeway had a verified installation/upgrade
_time_semester: which semester (1, 2) of the year a bikeway had a verified installation/upgrade, where:
- 1: represents November to April of next year
- 2: represents May to October of next year

Note: Date ranges that fall between months, quarters, thirds, or halves of the year were excluded from being classified as any of the time units (e.g. March 31 to April 15 will be excluded as it does not fall within either the 1st or 2nd quarter of the year).

# Add time unit columns via mutate
bike <- bike %>%
    mutate(
        
        # Months (monthly)
        `_time_month` = case_when(
            verify_date_type %in% c("day", "month") ~ month(verify_date, label = T, abbr = F)
        ),
        `_time_month` = as.numeric(`_time_month`),
        
        # Quarters (quarterly)
        `_time_quarter` = case_when(
            month(verify_date) %in% 1:3 |
            (
                month(verify_date_start) %in% 1:3 &
                month(verify_date_end) %in% 1:3 &
                year(verify_date_start) == year(verify_date_end)
            ) ~ 1,
            month(verify_date) %in% 4:6 |
            (
                month(verify_date_start) %in% 4:6 &
                month(verify_date_end) %in% 4:6 &
                year(verify_date_start) == year(verify_date_end)
            ) ~ 2,
            month(verify_date) %in% 7:9 |
            (
                month(verify_date_start) %in% 7:9 &
                month(verify_date_end) %in% 7:9 &
                year(verify_date_start) == year(verify_date_end)
            ) ~ 3,
            month(verify_date) %in% 10:12 |
            (
                month(verify_date_start) %in% 10:12 &
                month(verify_date_end) %in% 10:12 &
                year(verify_date_start) == year(verify_date_end)
            ) ~ 4
        ),
        
        # Thirds (triyearly)
        `_time_third` = case_when(
            month(verify_date) %in% 1:4 |
            (
                month(verify_date_start) %in% 1:4 &
                month(verify_date_end) %in% 1:4 &
                year(verify_date_start) == year(verify_date_end)
            ) ~ 1, # Fall
            month(verify_date) %in% 5:8 |
            (
                month(verify_date_start) %in% 5:8 &
                month(verify_date_end) %in% 5:8 &
                year(verify_date_start) == year(verify_date_end)
            ) ~ 2, # Winter
            month(verify_date) %in% 9:12 |
            (
                month(verify_date_start) %in% 9:12 &
                month(verify_date_end) %in% 9:12 &
                year(verify_date_start) == year(verify_date_end)
            ) ~ 3 # Spring/Summer
        ),
        
        # Halves (biyearly)
        `_time_half` = case_when(
            month(verify_date) %in% 1:6 |
            (
                month(verify_date_start) %in% 1:6 &
                month(verify_date_end) %in% 1:6 &
                year(verify_date_start) == year(verify_date_end)
            ) ~ 1,
            month(verify_date) %in% 7:12 |
            (
                month(verify_date_start) %in% 7:12 &
                month(verify_date_end) %in% 7:12 &
                year(verify_date_start) == year(verify_date_end)
            ) ~ 2
        ),
        
        # Semester (custom range)
        `_time_semester` = case_when(
            month(verify_date) %in% c(11:12, 1:4) |
            (
                month(verify_date_start) %in% c(11:12, 1:4) &
                ( # Nov to Dec of this year
                    month(verify_date_end) %in% 11:12 &
                    year(verify_date_end) == year(verify_date_start)
                ) |
                ( # Jan to Apr of this or next year
                    month(verify_date_end) %in% 1:4 &
                    year(verify_date_end) == year(verify_date_start) |
                    year(verify_date_end) == (year(verify_date_start) + 1)
                )
            ) ~ 2, # Nov to Apr of next year
            month(verify_date) %in% 5:10 |
            (
                month(verify_date_start) %in% 5:10 &
                month(verify_date_end) %in% 5:10 &
                year(verify_date_start) == year(verify_date_end)
            ) ~ 1 # May to Oct
        )
    )

# Display time unit cols
bike %>%
    as_tibble %>%
    select(
        verify_date_type,
        verify_date,
        verify_date_start,
        verify_date_end,
        starts_with("_")
    ) %>%
    arrange(`_pivot_value`)

Filter Verified Post-2011

Filter for bikeways with a verified installation or upgrade after 2011.

# Add filter columns
bike <- bike %>%
    filter(`_pivot_year` > 2011)

# Display filtered rows
bike %>%
    as_tibble %>%
    select(
        `_pivot_year`,
        `_pivot_type`,
        verify_install_year,
        verify_upgrade1_year,
        verify_upgrade2_year
    ) %>%
    arrange(`_pivot_year`)

Determine Unit of Time

Determine the temporal resolution (unit of time) finer than yearly based on the amount of data available per time unit (sorted from the highest resolution time unit to the lowest resolution time unit):

Month (high): refers to verified post-2011 installs and upgrades occurring approximately in a month (1/12) of a year
Quarter: refers to verified post-2011 installs and upgrades occurring approximately in a quarter (1/4) of a year
Third: refers to verified post-2011 installs and upgrades occurring approximately in a third (1/3) of a year
Half (low): refers to verified post-2011 installs and upgrades occurring approximately in a half (1/2) of a year
Semester (low): refers to verified post-2011 installs and upgrades occurring approximately in a half (1/2) of a year with the first half (1) being November (same year) to April (next year) and the second half being May to October (next year)

As there seems to be a large improvement in the percentage of records across cities from quarters to thirds of a year, and diminishing improvements when lowering the resolution to halves of a year, thirds of a year was chosen as the unit of time.

# Prepare plot data
unit_data <- bike %>%
    as_tibble %>%
    group_by(city) %>%
    summarize( # calc installs/upgrades for each time unit
        Month = sum(!is.na(`_time_month`)),
        Quarter = sum(!is.na(`_time_quarter`)),
        Third = sum(!is.na(`_time_third`)),
        Half = sum(!is.na(`_time_half`)),
        Semester = sum(!is.na(`_time_semester`))
    ) %>%
    pivot_longer(
        cols = -city,
        names_to = "type",
        values_to = "n"
    ) %>%
    mutate( # zero as NA
        n = if_else(n == 0, NA, n)
    ) %>%
    left_join( # Add city totals
        bike %>%
            as_tibble %>%
            group_by(city) %>%
            count(name = "total"),
        by = "city"
    ) %>%
    ungroup %>%
    mutate( # calc percentages and add labels
        type = factor(type, levels = c("Month", "Quarter", "Third", "Half", "Semester")),
        city = factor(str_to_title(city), levels = c("Vancouver", "Calgary", "Toronto")),
        perc = n / total * 100,
        perc_label = glue(
            "{str_sub(city, end = 1)}: {round(perc, 2)}%\n",
            "(n={format(n, big.mark = ',', scientific = F)})"
        )
    ) %>%
    group_by(type) %>% # adjust overlapping labels
    arrange(desc(perc)) %>% 
    mutate( # detect overlap labels and shift down and up
        perc_label_y = case_when(
            lag(perc) - perc < 2 ~ perc - 1.5,
            lead(perc) - perc > -2 ~ perc + 1.5,
            .default = perc
        )
    ) %>%
    group_by(city) %>%
    mutate( # add city labels at end of lines
        city_label = if_else(
            type == "Semester",
            glue(
                "{city}\n",
                "(n={format(total, big.mark = ',', scientific = F)})"
            ),
            NA
        )
    ) %>%
    ungroup %>%
    arrange(city, type)

# Get total
unit_total <- sum(unit_data$total %>% unique, na.rm = T)
unit_total_label <- format(unit_total, big.mark = ",", scientific = F)

# Plot line
unit_plot <- unit_data %>%
    ggplot(aes(
        x = type,
        y = perc,
        group = city,
        color = city,
        label = perc_label
    )) +
    geom_line(
        alpha = 0.8,
        linewidth = 1.5
    ) +
    geom_label(
        aes(y = perc_label_y),
        size = 2,
        show.legend = F,
        label.padding = unit(0.5, "lines")
    ) +
    geom_text(
        aes(
            label = city_label,
            y = perc_label_y
        ),
        size = 2.25,
        show.legend = F,
        hjust = 0,
        nudge_x = 0.25
    ) +
    scale_y_continuous(labels = function(x) paste0(x, "%")) +
    scale_x_discrete(
        limits = levels(unit_data$type),
        position = "top"
    ) +
    labs(
        title = glue(
            "% of Verified Post-2011 Installs & Upgrades by Unit of Time\n",
            "(n={unit_total_label})"
        ),
        x = NULL,
        y = NULL,
        color = "City",
        label = NULL,
        group = NULL
    ) +
    theme_minimal() +
    theme(
        legend.position = "none",
        plot.title = element_text(hjust = 0.5)
    )
unit_plot

# Select time unit
tunit = "third"

Join KSI

# Get minimum year
year_min <- bike %>%
    pull(`_pivot_year`) %>%
    min(., na.rm = T)

# Get maximum year
year_max <- bike %>%
    pull(`_pivot_year`) %>%
    max(., na.rm = T)

Cycling Interventions Evaluation

R Code

Richard Wen richard.wen@utoronto.ca

Brice Batomen brice.kuimi@utoronto.ca

Linda Rothman linda.rothman@torontomu.ca

Andrew Howard andrew.howard@sickkids.ca

June 20, 2024

Installation

Running This Code

Libraries

Data

Vancouver Bikeways

Map

Data

Dictionary

Details

Files

Calgary Bikeways

Map

Data

Dictionary

Details

Files

Toronto Bikeways

Map

Data

Dictionary

Details

Files

Verified Dates

Data

Dictionary

Files

Toronto KSI

Map

Data

Dictionary

Details

Files

Cleaning

Combine Bikeways

Pivot Long Format

Add Clean Dates

Add Time Units

Filter Verified Post-2011

Determine Unit of Time

Join KSI